home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Toolbox
/
Visual Basic Toolbox (P.I.E.)(1996).ISO
/
version
/
verdll
/
verinfo1.frm
< prev
next >
Wrap
Text File
|
1994-10-16
|
7KB
|
275 lines
VERSION 2.00
Begin Form verinfo1
BorderStyle = 1 'Fixed Single
Caption = "VerInfo Demo"
Height = 4980
Icon = VERINFO1.FRX:0000
Left = 2280
LinkMode = 1 'Source
LinkTopic = "Form1"
ScaleHeight = 17.875
ScaleMode = 4 'Character
ScaleWidth = 32.125
Top = 1815
Width = 3975
Begin DriveListBox Drive1
Height = 288
Left = 1836
TabIndex = 7
Top = 3792
Width = 1908
End
Begin DirListBox Dir1
Height = 1884
Left = 1830
TabIndex = 5
Top = 1428
Width = 1896
End
Begin FileListBox File1
Height = 2955
Left = 120
TabIndex = 3
Top = 984
Width = 1575
End
Begin TextBox Text1
Height = 288
Left = 1092
TabIndex = 1
Text = "*.*"
Top = 204
Width = 2544
End
Begin Label Label1
Caption = "Dri&ves:"
Height = 216
Index = 4
Left = 1830
TabIndex = 6
Top = 3480
Width = 660
End
Begin Label Label1
Caption = "&Directories:"
Height = 192
Index = 3
Left = 1830
TabIndex = 4
Top = 1104
Width = 1236
End
Begin Label Label1
Caption = "c:\"
Height = 204
Index = 2
Left = 1830
TabIndex = 8
Top = 648
Width = 1884
End
Begin Label Label1
Caption = "&Files:"
Height = 204
Index = 0
Left = 120
TabIndex = 2
Top = 648
Width = 612
End
Begin Label Label1
Caption = "File&Name:"
Height = 204
Index = 1
Left = 120
TabIndex = 0
Top = 252
Width = 936
End
Begin Menu AboutBox
Caption = "&About"
End
Begin Menu EndProgram
Caption = "&End"
End
End
Sub AboutBox_Click ()
About2.Show
End Sub
Sub Dir1_Change ()
File1.Path = Dir1.Path
Label1(2).Caption = File1.Path
End Sub
Sub DisplayVerInfo ()
Dim X As VS_VERSION
'*** Get Version Info ****
FileVer$ = "": ProdVer$ = "": FileFlags$ = ""
FileOS$ = "": FileType$ = "": FileSubType$ = ""
FileName$ = File1.List(File1.ListIndex)
Directory$ = Label1(2).Caption
FullFileName$ = Label1(2).Caption + "\" + FileName$
BufSize& = GetFileVersionInfoSize(FullFileName$, dwHandle&)
If BufSize& = 0 Then
MsgBox "No Version Info available!"
Exit Sub
End If
lpvData$ = Space$(BufSize&)
r% = GetFileVersionInfo(FullFileName$, dwHandle&, BufSize&, lpvData$)
hmemcpy X, ByVal lpvData$, Len(X)
'**** Determine File Version number ****
FileVer$ = LTrim$(Str$(HIWORD(X.dwFileVersionMS))) + "."
FileVer$ = FileVer$ + LTrim$(Str$(LOWORD(X.dwFileVersionMS)))
'**** Determine Product Version number ****
ProdVer$ = LTrim$(Str$(HIWORD(X.dwFileVersionMS))) + "."
ProdVer$ = ProdVer$ + LTrim$(Str$(LOWORD(X.dwProductVersionMS)))
'**** Determine Boolean attributes of File ****
If X.dwFileFlags And VS_FF_DEBUG Then FileFlags$ = "DeBug"
If X.dwFileFlags And VS_FF_PRERELEASE Then FileFlags$ = FileFlags$ + "PreRel"
If X.dwFileFlags And VS_FF_PATCHED Then FileFlags$ = FileFlags$ + "Patched"
If X.dwFileFlags And VS_FF_PRIVATEBUILD Then FileFlags$ = FileFlags$ + "Private"
If X.dwFileFlags And VS_FF_INFOINFERRED Then FileFlags$ = FileFlags$ + "Info"
If X.dwFileFlags And VS_FF_DEBUG Then FileFlags$ = FileFlags$ + "Special"
If X.dwFileFlags And &HFFFFFF00 Then FileFlags$ = FileFlags$ + "Unknown"
'**** Determine OS for which file was designed ****
Select Case X.dwFileOS
Case VOS_DOS_WINDOWS16
FileOS$ = "DOS-Win16"
Case VOS_DOS_WINDOWS32
FileOS$ = "DO =Win32"
Case VOS_OS216_PM16
FileOS$ = "OS/2-16 PM-16"
Case VOS_OS232_PM32
FileOS$ = "OS/2-32 PM-32"
Case VOS_NT_WINDOWS32
FileOS$ = "NT-Win32"
Case Else
FileOS$ = "Unknown"
End Select
'**** Determine Type and SubType of File ****
Select Case X.dwFileType
Case VFT_APP
FileType$ = "App"
Case VFT_DLL
FileType$ = "DLL"
Case VFT_DRV
FileType$ = "Driver"
Select Case X.dwFileSubType
Case VFT2_DRV_PRINTER
FileSubType$ = "Printer drv"
Case VFT2_DRV_KEYBOARD
FileSubType$ = "Keyboard drv"
Case VFT2_DRV_LANGUAGE
FileSubType$ = "Language drv"
Case VFT2_DRV_DISPLAY
FileSubType$ = "Display drv"
Case VFT2_DRV_MOUSE
FileSubType$ = "Mouse drv"
Case VFT2_DRV_NETWORK
FileSubType$ = "Network drv"
Case VFT2_DRV_INSTALLABLE
FileSubType$ = "Installable"
Case VFT2_DRV_SOUND
FileSubType$ = "Sound drv"
Case VFT2_DRV_COMM
FileSubType$ = "Comm drv"
Case VFT2_UNKNOWN
FileSubType$ = "Unknown"
End Select
Case VFT_FONT
FileType$ = "Font"
Select Case X.dwFileSubType
Case VFT_FONT_RASTER
FileSubType$ = "Raster Font"
Case VFT_FONT_VECTOR
FileSubType$ = "Vector Font"
Case VFT_FONT_TRUETYPE
FileSubType$ = "TrueType Font"
End Select
Case VFT_VXD
FileType$ = "VxD"
Case VFT_STATIC_LIB
FileType$ = "Lib"
Case Else
FileType$ = "Unknown"
End Select
Verinfo2.Show 1
End Sub
Sub Drive1_Change ()
Dir1.Path = Drive1.Drive
File1.Path = Dir1.Path
Label1(2).Caption = File1.Path
End Sub
Sub EndProgram_Click ()
End
End Sub
Sub File1_Click ()
Text1.Text = File1.List(File1.ListIndex)
End Sub
Sub File1_DblClick ()
DisplayVerInfo
End Sub
Sub File1_PathChange ()
Text1.Text = "*.*"
File1.Pattern = "*.*"
End Sub
Sub Form_Load ()
Dim Buffer$
' **** Set Default Dir to Windows System Subdirectory ****
Buffer$ = Space$(256)
r% = GetSystemDirectory(Buffer$, Len(Buffer$))
Dir1.Path = Buffer$
File1.Path = Buffer$
Drive1.Drive = Left$(Buffer$, 1)
About2.lbl_Title = "VER.DLL Demo"
About2.lbl_Version = "Version 10.15.94"
End Sub
Function HIWORD (X As Long) As Integer
HIWORD = X \ &HFFFF&
End Function
Function LOWORD (X As Long) As Integer
LOWORD = X And &HFFFF&
End Function
Sub Text1_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
File1.Pattern = Text1.Text
KeyAscii = 0
If File1.ListCount = 1 Then DisplayVerInfo
If File1.ListCount = 0 Then
MsgBox "Invalid Filename"
File1.Pattern = "*.*"
Text1.Text = "*.*"
End If
File1.SetFocus
End If
End Sub
